home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
percnt.zip
/
CTRLDLGS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-11-12
|
14KB
|
414 lines
{***************************************************************************
NoMan Custom Control Library $Version$
Style Dialog Box Function Unit
$Author$ $Date$
Copyright 1991 Anthony M. Vitabile
Unit Description
This Turbo Pascal for Windows unit contains the code for
controlling the style dialog boxes for each of the custom
controls defined in this library. Procedures common to all
dialog boxes are defined first, which control the operation of
various controls in the dialog boxes. Then two procedures
specific to each control are defined. The first of these is a
procedure that causes a dialog box to be displayed, and the
second is an actual Windows Dialog Box procedure.
The library uses straight Windows calls and does NOT use Object-
Windows calls. This is to allow the control to be used by ANY
Windows program.
This code is adapted from the code that appeared in the July,
1990 issue of Microsoft Systems Journal article, "Extending the
Windows 3.0 Interface with Installable Custom Controls" by Kevin
P. Welch. It has been extended to support the multi-control
DLL format defined by Borland for use with its Resource Workshop
resource editor.
***************************************************************************}
{$C DemandLoad Discardable}
Unit CtrlDlgs;
Interface
Uses WinTypes, CustCntl;
procedure CenterPopup(HWindow, HParent: HWnd); export;
function PercentCtrlStyle(HWindow : HWnd;
CtrlStyle: THandle;
StrToID : TStrToId;
IDToStr : TIdToStr
): LongBool; export;
function PercentCtrlDlgFn(HDlg : HWnd;
Message,
wParam : word;
lParam : longint
): Bool; export;
Implementation
Uses CtrlCommonDefs, Strings, WinProcs;
const
hCtrlStyle : PChar = MakeIntResource(1);
LpStrToIDLo: PChar = MakeIntResource(2);
LpStrToIDHi: PChar = MakeIntResource(3);
TheStyleArr: PChar = MakeIntResource(4);
StyleDialog: PChar = 'PercentStyle';
ID_Identifier = 100; { Control: ID edit control ID }
ID_IDValue = 101; { Control: Static text w/ID as a number }
ID_Title = 102; { Control: Title edit control ID }
ID_Tabstop = 103; { Control: tabstop radio button }
ID_Group = 104; { Control: group radio button }
type
StyleArray = array [ID_Tabstop .. ID_Tabstop + 16] of longint;
var
CtrlStyleTemp: THandle; { Holds the TRWCtlStyle handle passed to PercentCtrlStyle }
UseStrToID : TStrToID; { Address of function to convert from a string to an ID }
UseIDToStr : TIDToStr; { Address of function to convert from an ID to a string }
procedure Buttons(HWindow : HWnd;
CtlStyle: PRWCtlStyle;
TheBtn ,
FstBtn ,
LstBtn : integer;
TheMask : longint;
var TheStyle: StyleArray);
begin { Buttons }
CheckRadioButton(hWindow, FstBtn, LstBtn, TheBtn);
if CtlStyle <> nil
then
with CtlStyle^ do
dwStyle := dwStyle and TheMask or TheStyle[TheBtn]
else
for TheBtn := FstBtn to LstBtn do
EnableWindow(GetDlgItem(HWindow, TheBtn), FALSE)
end { Buttons };
procedure CenterPopup(HWindow, HParent: HWnd);
var
xPopup ,
yPopup ,
cxPopup ,
cyPopup ,
cxScreen,
cyScreen,
cxParent,
cyParent: integer;
rcWindow: TRect;
begin { CenterPopup }
{ Retrieve main display dimensions }
cxScreen := GetSystemMetrics(sm_CXScreen);
cyScreen := GetSystemMetrics(sm_CYScreen);
{ Retrieve popup rectangle }
GetWindowRect(HWindow, rcWindow);
{ Calculate popup size }
cxPopup := rcWindow.right - rcWindow.left;
cyPopup := rcWindow.bottom - rcWindow.top;
{ Calculate bounding rectangle }
if HParent = 0
then
begin
xPopup := (cxScreen - cxPopup) div 2;
yPopup := (cyScreen - cyPopup) div 2
end
else
begin
GetWindowRect(HParent, rcWindow);
cxParent := rcWindow.right - rcWindow.left;
cyParent := rcWindow.bottom - rcwindow.top;
{ Center within parent window }
xPopup := rcWindow.left + ((cxParent - cxPopup) div 2);
yPopup := rcWindow.top + ((cyParent - cyPopup) div 2);
{ Adjust popup x-location for screen size }
if (xPopup + cxPopup) > cxScreen
then xPopup := cxScreen - cxPopup;
if (yPopup + cyPopup) > cyScreen
then yPopup := cyScreen - cyPopup
end;
if xPopup < 0
then xPopup := 0;
if yPopup < 0
then yPopup := 0;
MoveWindow(hWindow, xPopup, yPopup, cxPopup, cyPopup, TRUE)
end { CenterPopup };
procedure CheckBit(HWindow : HWnd;
CtlStyle: PRWCtlStyle;
ID : word;
var TheStyle: StyleArray);
begin { CheckBit }
if CtlStyle = nil
then EnableWindow(GetDlgItem(HWindow, ID), FALSE)
else
with CtlStyle^ do
begin
dwStyle := dwStyle xor TheStyle[ID];
CheckDlgButton(HWindow, ID, ord((dwStyle and TheStyle[ID]) <> 0))
end
end { CheckBit };
procedure ProcessOK(HDlg : HWnd;
CtlStyle: PRWCtlStyle;
StrToID : TStrToID);
var
bClose: boolean;
wSize : word;
Result: longint;
TheID : packed array [0 .. ctlTitle] of char;
temp : string[10];
begin { ProcessOK }
bClose := FALSE;
if CtlStyle <> nil
then
begin
GetDlgItemText(HDlg, id_Title, CtlStyle^.szTitle, ctlTitle);
@StrToId := Pointer(MakeLong(
GetProp(HDlg, LpStrToIDLo),
GetProp(HDlg, LpStrToIDHi)));
wSize := GetDlgItemText(HDlg, id_Identifier, TheID, sizeof(TheID));
TheID[wSize] := #0;
if @StrToID = nil
then
begin
temp := StrPas(TheID);
Val(temp, Result, wSize);
if wSize = 0
then
begin
bClose := TRUE;
CtlStyle^.wID := Result
end
end
else
begin
Result := StrToID(TheID);
if LoWord(Result) <> 0
then
begin
bClose := TRUE;
CtlStyle^.wID := HiWord(Result)
end
end
end;
if bClose
then EndDialog(HDlg, ord(TRUE))
end { ProcessOK };
procedure SetButtons(hDlg : HWnd;
CtrlStyle : PRWCtlSTyle;
FirstButton,
LastButton : integer;
TheMask : longint;
var TheStyle : StyleArray);
var
i: integer;
begin { SetButtons }
if CtrlStyle = nil
then Buttons(hDlg, CtrlStyle, FirstButton, FirstButton, LastButton, TheMask, TheStyle)
else
with CtrlStyle^ do
begin
i := FirstButton;
while (i <= LastButton) and ((dwStyle and TheStyle[i]) = 0) do
inc(i);
if i > LastButton
then i := FirstButton;
Buttons(hDlg, CtrlStyle, i, FirstButton, LastButton, TheMask, TheStyle)
end
end { SetButtons };
procedure SetCheckBox(hDlg : HWnd;
CtrlStyle: PRWCtlStyle;
Button : integer;
TheMask : longint);
var
State: word;
begin { SetCheckBox }
if CtrlStyle = nil
then State := 0
else State := word((CtrlStyle^.dwStyle and TheMask) <> 0);
CheckDlgButton(hDlg, Button, State)
end { SetCheckBox };
procedure SetID(hDlg : HWnd;
CtrlStyle: PRWCtlStyle;
IDToStr : TIDToStr);
var
PCtrlStyle: PRWCtlStyle;
TheID : packed array [0 .. 32] of char;
temp : string[10];
begin { SetID }
Str(CtrlStyle^.wID:1, temp);
StrPCopy(TheID, temp);
SetDlgItemText(HDlg, id_IDValue, TheID);
if @IDToStr <> nil
then IDToStr(PCtrlStyle^.wID, TheID, sizeof(TheID));
SetDlgItemText(HDlg, id_Identifier, TheID)
end { SetID };
procedure TestAxis(HWindow : HWnd;
CtlStyle: PRWCtlStyle;
Button : integer;
Mask : longint;
var TheStyle: StyleArray);
begin { TestAxis }
if CtlStyle <> nil
then
with CtlStyle^ do
EnableWindow(GetDlgItem(HWindow, Button), (dwStyle and Mask <> 0))
end { TestAxis };
function PercentCtrlStyle(HWindow : HWnd;
CtrlStyle: THandle;
StrToID : TStrToID;
IDToStr : TIDToStr
): LongBool;
var
Result: LongBool;
lpProc: TFarProc;
begin { PercentCtrlStyle }
if CtrlStyle = 0
then Result := FALSE
else
begin
CtrlStyleTemp := CtrlStyle;
UseStrToID := StrToID;
UseIDToStr := IDToStr;
lpProc := MakeProcInstance(@PercentCtrlDlgFn, HInstance);
Result := LongBool(DialogBox(HInstance, StyleDialog, HWindow, lpProc));
FreeProcInstance(lpProc)
end;
PercentCtrlStyle := Result
end { PercentCtrlStyle };
function PercentCtrlDlgFn(HDlg : HWnd;
Message,
wParam : word;
lParam : longint
): Bool;
label 1;
const
ID_NoGrads = 105; { Control: No Grads radio button }
ID_10Grads = 106; { Control: 10% Grads radio button }
ID_25Grads = 107; { Control: 25% Grads radio button }
ID_50Grads = 108; { Control: 50% Grads radio button }
ID_DrawAxis = 109; { Control: Draw Axis radio button }
ID_DrawPct = 110; { Control: Draw % radio button }
var
Result : Bool;
CtlStyle,
Style : THandle;
PStyle : PRWCtlStyle;
TheStyle: ^StyleArray;
StrToID : TStrToID;
begin { PercentCtrlDlgFn }
Result := TRUE;
if Message <> wm_InitDialog
then
begin
CtlStyle := GetProp(HDlg, hCtrlStyle);
if CtlStyle = 0
then PStyle := nil
else PStyle := GlobalLock(CtlStyle);
@StrToID := Pointer(MakeLong(GetProp(HDlg, LpStrToIDLo),
GetProp(HDlg, LpStrToIDHi)));
Style := GetProp(HDlg, TheStyleArr);
TheStyle := GlobalLock(Style)
end;
case Message of
wm_InitDialog:
begin
Style := GlobalAlloc(gmem_Moveable or gmem_ZeroInit, sizeof(StyleArray));
if Style = 0
then
begin
MessageBox(HDlg, 'Cannot Create Style Array!', nil, mb_IconExclamation or mb_OK);
EndDialog (HDlg, ord(FALSE));
goto 1
end;
TheStyle := GlobalLock(Style);
if TheStyle = nil
then
begin
MessageBox(HDlg, 'Cannot Lock Style Array!', nil, mb_IconExclamation or mb_OK);
GlobalFree(Style);
EndDialog (HDlg, ord(FALSE));
goto 1
end;
TheStyle^[ID_TabStop ] := ws_TabStop; { Set up the style array }
TheStyle^[ID_Group ] := ws_Group; { With Percent Control data }
TheStyle^[ID_NoGrads ] := 0;
TheStyle^[ID_10Grads ] := Pct_Decades;
TheStyle^[ID_25Grads ] := Pct_Quarters;
TheStyle^[ID_50Grads ] := Pct_Halves;
TheStyle^[ID_DrawAxis] := Pct_Axis;
TheStyle^[ID_DrawPct ] := Pct_Digits;
{ Initialize the property list }
SetProp(HDlg, hCtrlStyle , CtrlStyleTemp);
SetProp(HDlg, LpStrToIDLo, LoWord(longint(@UseStrToID)));
SetProp(HDlg, LpStrToIDHi, HiWord(longint(@UseStrToID)));
SetProp(HDlg, TheStyleArr, Style);
PStyle := GlobalLock(CtrlStyleTemp);
CenterPopup (HDlg, GetParent(HDlg)); { Center the popup in the parent window }
SetDlgItemText(HDlg, id_Title, PStyle^.szTitle);
SetID (HDlg, Pstyle, UseIDToStr);
SetButtons (HDlg, PStyle, ID_NoGrads , ID_50Grads, PctMask, TheStyle^);
SetCheckBox (HDlg, PStyle, ID_DrawAxis, Pct_Axis );
SetCheckBox (HDlg, PStyle, ID_DrawPct , Pct_Digits);
SetCheckBox (HDlg, PStyle, ID_TabStop , ws_TabStop);
SetCheckBox (HDlg, PStyle, ID_Group , ws_Group );
TestAxis (HDlg, PStyle, ID_DrawAxis, not PctMask, TheStyle^)
end;
wm_Command :
case wParam of
IDOK : ProcessOK(HDlg, PStyle, StrToID); { Process the OK button }
IDCancel : EndDialog(HDlg, ord(FALSE)); { Process the Cancel button }
ID_NoGrads ..
ID_50Grads : begin
Buttons (hDlg, PStyle, wParam , ID_NoGrads, ID_50Grads, PctMask, TheStyle^);
TestAxis(HDlg, PStyle, ID_DrawAxis, not PctMask, TheStyle^)
end;
ID_DrawAxis,
ID_DrawPct ,
ID_TabStop ,
ID_Group : CheckBit(hDlg, PStyle, wParam, TheStyle^);
end;
wm_Destroy :
begin
RemoveProp(HDlg, hCtrlStyle); { Clean up the property list }
RemoveProp(HDlg, LpStrToIDLo);
RemoveProp(HDlg, LpStrToIDHi);
RemoveProp(HDlg, TheStyleArr)
end
else Result := FALSE
end;
GlobalUnlock(Style);
1: PercentCtrlDlgFn := Result
end { PercentCtrlDlgFn };
end.